home *** CD-ROM | disk | FTP | other *** search
/ IRIX 6.4 Applications 1997 August / SGI IRIX 6.4 Applications 1997 August.iso / dist / custlink.idb / usr / custlink / util / mailer.pl.z / mailer.pl
Encoding:
Perl Script  |  1997-07-30  |  6.5 KB  |  308 lines
  1. #!/usr/sbin/perl
  2. #
  3. # This is UNPUBLISHED PROPRIETARY SOURCE CODE of Silicon Graphics, Inc.
  4. #
  5. # A simple mailer that supports webjumper attachment and non-ascii content.
  6. # It is intended to be used within custreg and memphis.
  7. # 
  8. # command line:
  9. #
  10. # mailer.pl [-subject subject] 
  11. #           [-from from-string] [-cc cc-addr]
  12. #           [-attach type:filepath] dest < content
  13. #
  14.  
  15. #
  16. # constants
  17. #
  18. $flagExclusiveLock = 2;
  19. $flagUnlock = 8;
  20.  
  21. #
  22. # customizable variables
  23. #
  24. $mailerFile  = "/usr/tmp/custreg_mailer_$$.txt";
  25.  
  26. #
  27. # a list of charsets, the default will be iso-8859-1
  28. #
  29. %CHARSETS = (
  30.          'ja_JP',     'iso-2022-jp',
  31.          'ja_JP.EUC', 'iso-2022-jp',
  32.          'ko_KR',     'iso-2022-kr',
  33.          'ko_KR.EUC', 'iso-2022-kr',
  34.          'en_US',     'us-ascii',
  35.          'C',         'us-ascii',
  36.          'de',        'iso-8859-1',
  37.          'fr',        'iso-8859-1',
  38.          'fr_CA',     'iso-8859-1',
  39.          'es',        'iso-8859-1',
  40.          'es_MX',     'iso-8859-1',
  41.          );
  42.  
  43. #
  44. # lang, if it's a multi-byte language
  45. #
  46. %MULTIBYTELANG = (
  47.         'ja_JP',     1,
  48.         'ja_JP.EUC', 1,
  49.         'ko_KR',     1,
  50.         'ko_KR.EUC', 1,
  51.         );
  52. #
  53. # $INPUTS associative array stores input arguments
  54. # 
  55. %INPUTS = ();
  56.  
  57. #
  58. # start of mailer
  59. #
  60.  
  61. if ($#ARGV < 0) {
  62.     print <<End_Usage;
  63. Usage:
  64. mailer.pl flags dest < content
  65.  
  66. where flags can be:
  67.       [-subject subject]
  68.       [-from from-string] 
  69.       [-cc cc-addr]
  70.       [-attach type:filepath]
  71. End_Usage
  72.  
  73.     exit(1);
  74. }
  75. else {
  76.     #
  77.     # obtain cmd line arguments 
  78.     #
  79.     &getCmdLineArgs(*INPUTS);
  80.     
  81.     &buildMailFile(*INPUTS);
  82.     &sendMailFile();
  83. }
  84.  
  85.  
  86. #
  87. # obtain cmd line arguments
  88. #
  89. sub getCmdLineArgs
  90. {
  91.     #
  92.     # loop thru the cmdline options
  93.     #
  94.     $i = 0;
  95.     while($i <= $#ARGV) {
  96.     if ($ARGV[$i] eq "-subject") {
  97.         $i++;
  98.         $INPUTS{'subject'} = $ARGV[$i];
  99.     }
  100.     elsif ($ARGV[$i] eq "-from") {
  101.         $i++;
  102.         $INPUTS{'from'} = $ARGV[$i];
  103.     }
  104.     elsif ($ARGV[$i] eq "-cc") {
  105.         $i++;
  106.         $INPUTS{'cc'} = $ARGV[$i];
  107.     }
  108.     elsif ($ARGV[$i] eq "-attach") {
  109.         $i++;
  110.         $INPUTS{'attach'} = $ARGV[$i];
  111.     }
  112.     else {
  113.         #
  114.         # dest address.
  115.         #
  116.         $INPUTS{'dest'} = $ARGV[$i];
  117.     }
  118.     $i++;
  119.     }
  120. }
  121.  
  122. #
  123. # build the mailer file with proper MIME headers
  124. #
  125. sub buildMailFile
  126. {
  127.     open(FILE, "> $mailerFile") || die "Cannot open: $mailerfile: $!\n";
  128.     
  129.     flock(FILE, $flagExclusiveLock);
  130.  
  131.     #
  132.     # get host name
  133.     #
  134.     $host = `/usr/bsd/hostname`;
  135.     chop $host;
  136.     local(@a) = gethostbyname($host);
  137.     $host = $a[0] unless ! @a;
  138.  
  139.     #
  140.     # print the mail header
  141.     #
  142.     if ($INPUTS{'from'} ne "") {
  143.     if ($INPUTS{'from'} =~ /<\w+>/) {
  144.         print FILE "From: $INPUTS{'from'}\n";
  145.     }
  146.     else {
  147.         $login = getlogin || (getpwuid($<))[0] || "nobody";
  148.         if ($INPUTS{'to'} =~ /\@/) {
  149.         print FILE "From: $INPUTS{'from'} <$login@$host>\n";
  150.         }
  151.         else {
  152.         print FILE "From: $INPUTS{'from'} <$login>\n";
  153.         }
  154.     }
  155.     }
  156.  
  157.     print FILE "X-Mailer: mailer.pl (SGI/CustReg/mailer)\n";
  158.     print FILE "To: $INPUTS{'dest'}\n";
  159.     print FILE "Subject: $INPUTS{'subject'}\n";
  160.     print FILE "Cc: $cc\n";
  161.  
  162.     # 
  163.     # print the MIME header
  164.     #
  165.     print FILE "Mime-Version: 1.0\n";
  166.  
  167.     $boundary = "PART-BOUNDARY=.$$.$host";
  168.  
  169.     if ($INPUTS{'attach'}) {
  170.     print FILE "Content-Type: multipart/mixed;\n";
  171.     print FILE " boundary=\"$boundary\"\n\n";
  172.  
  173.     #
  174.     # separator
  175.     #
  176.     print FILE "--\n--$boundary\n";
  177.     }
  178.  
  179.     #
  180.     # email body
  181.     #
  182.     $lang = $ENV{'LANG'};
  183.     $charset = $CHARSETS{$lang};
  184.     if ($charset eq "") {
  185.     $charset = "us-ascii";
  186.     }
  187.     $content = "";
  188.     while(<STDIN>) { $content .= $_; }
  189.  
  190.     print FILE "Content-Type: text/plain; charset=$charset\n";
  191.  
  192.     #
  193.     # No encoding - Tony Tam 11/21/96
  194.     #
  195.     print FILE "\n";
  196.     print FILE $content;
  197.  
  198. ############################################################
  199. # TAKE OUT THIS SECTION BECAUSE MEMPHIS ALREADY DOES
  200. # ENCODING - Tony Tam 11/21/96
  201. #
  202. #    if (($lang eq "") || ($lang eq "en_US") || ($lang eq "C")) {
  203. #    print FILE "\n";
  204. #    print FILE $content;
  205. #    }
  206. #    elsif ($MULTIBYTELANG{$lang}) {
  207. #    print FILE "Content-Transter-Encoding: base64\n\n";
  208. #    print FILE &encodeBase64($content);
  209. #    }
  210. #    else {
  211. #    print FILE "Content-Transter-Encoding: quote-printable\n\n";
  212. #    print FILE &encodeQuotedPrint($content);
  213. #    }
  214. #######################################################
  215.  
  216.     print FILE "\n";
  217.  
  218.     #
  219.     # attachment. it's mostly webjumper so we use charset=us-ascii
  220.     #
  221.     if ($INPUTS{'attach'}) {
  222.     ($atype, $afilepath) = split(/:/, $INPUTS{'attach'});
  223.     open (AFILE, $afilepath) || die "Cannot open $afilepath: $!\n";
  224.  
  225.     print FILE "\n--$boundary\n";
  226.     print FILE "Content-Type: $atype; charset=us-ascii\n\n";
  227.     
  228.     while (<AFILE>) {
  229.         print FILE;
  230.     }
  231.  
  232.     #
  233.     # separator
  234.     #
  235.     print FILE "\n--$boundary--\n\n";
  236.     }
  237.     
  238.     flock(FILE, $flagUnlock);
  239.     close(FILE);
  240. }
  241.  
  242. sub sendMailFile
  243. {
  244.     open (MAIL, "| /usr/lib/sendmail -t -n") || die "Cannot do sendmail: $!\n";
  245.  
  246.     open (FILE, $mailerFile) || die "Cannot open $mailerFile: $!\n";
  247.  
  248.     while (<FILE>) {
  249.     print MAIL;
  250.     }
  251.     close (FILE);
  252.     close (MAIL);
  253.  
  254.     unlink $mailerFile;
  255. }
  256.  
  257. #
  258. # encodeBase64 is backward ported from perl5's Base64::encode
  259. # because perl5 is not bundled to 6.3, as of 7/28/96.
  260. #
  261. sub encodeBase64
  262. {
  263.     local ($res) = "";
  264.     local ($src) = shift;
  265.     local ($eol) = shift;
  266.     $eol = "\n" unless defined $eol;
  267.     $* = 1;                                      # enalble multi-line patterns
  268.     while ($src =~ /(.{1,45})/g) {
  269.     $res .= substr(pack('u', $1), 1);
  270.     chop($res);
  271.     }
  272.     $* = 0;                                      # disable multi-line patterns
  273.  
  274.     $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
  275.     # fix padding at the end
  276.     local ($padding) = (3 - length($_[0]) % 3) % 3;
  277.     $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
  278.     # break encoded string into lines of no more than 76 characters each
  279.     if (length $eol) {
  280.     $res =~ s/(.{1,76})/$1$eol/g;
  281.     }
  282.  
  283.     $res;
  284. }
  285.  
  286. #
  287. # encodeQuotedPrint is backward ported from perl5's QuotedPrint::encode
  288. # because perl5 is not bundled to 6.3, as of 7/28/96.
  289. #
  290. sub encodeQuotedPrint
  291. {
  292.     local ($res) = shift;
  293.     $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;  # rule #2,#3
  294.     $res =~ s/([ \t]+)$/
  295.     join('', map { sprintf("=%02X", ord($_)) } split('', $1)
  296.       )/eg;                        # rule #3 (encode whitespace at eol)
  297.  
  298.     # rule #5 (lines must be shorter than 76 chars, but we are not allowed
  299.     # to break =XX escapes.  This makes things complicated :-( )
  300.     local ($brokenlines) = "";
  301.     $brokenlines .= "$1=\n" while $res =~ s/^(.{74}([^=]{2})?)//;
  302.     # unnessesary to make a break at the last char
  303.     $brokenlines =~ s/=\n$// unless length $res;
  304.  
  305.     "$brokenlines$res";
  306. }
  307.  
  308.